use strict;
use warnings;
use threads;
use threads::shared;
use Carp;
use Thread::Queue;
use XML::FeedPP;
use Date::Parse;
use Data::Dumper;
use DateTime;
use YAML::Syck;
use POE::Component::IKC::ClientLite;
use constant PATH => $ENV{HOME}."/irc/";

# Cookbook #16.18
use POSIX ":sys_wait_h";
$SIG{INT} = \&quit;

$Carp::Verbose = 1;

my %last_update : shared = ();

my $config;
if(-f 'config-rss.yaml') {
    $config = shared_clone(LoadFile('config-rss.yaml'));
}
else {
    print "Can't load config-rss.yaml\n";
    exit;
}

$config->{interval} ||= 600;
$config->{threads}  ||= 3;

my $remote;
if($config->{remote}) {
    die "remote->port is required." unless $config->{remote}->{port};
    die "remote->name is required." unless $config->{remote}->{name};
    $config->{remote}->{timeout} ||= 1;

    print Dumper($config->{remote});
    $remote = create_ikc_client(%{ $config->{remote} });
    die POE::Component::IKC::ClientLite::error() unless $remote;
}

my %parser = (
    _default  => \&parser_default,
    cpan      => \&parser_cpan,
    perlmania => \&parser_perlmania,
    perldoc   => \&parser_perldoc,
);

foreach my $rss_name (keys %{ $config->{rss_list} }) {
    my $rss = $config->{rss_list}->{$rss_name};
    if(!exists($rss->{parser}) or !exists($parser{ $rss->{parser} })) {
        $rss->{parser} = '_default';
    }
}

my $queue = Thread::Queue->new;
my @thr_check_rss;
foreach(1 .. $config->{threads}) {
    push @thr_check_rss, threads->create(\&job_check_rss, $queue);
}

while(1) {
    foreach my $rss_name (keys %{ $config->{rss_list} }) {
        $queue->enqueue($rss_name);
    }
    warn "MainThread Sleep 10sec\n";
    sleep 10;
}

quit() if @thr_check_rss;

sub quit {
    foreach(1 .. $config->{threads}) {
        $queue->enqueue(undef);
    }
    foreach my $thr (@thr_check_rss) {
        $thr->join();
    }
    @thr_check_rss = ();

    print "aggregate.pl is done.\n";

    exit;
}

sub send_rss_update {
    my ($rss_name, $item) = @_;

    my ($title, $author) = ('', '');
    ($title = $item->title) =~ s#(:?<b>|</b>)##g;
    ($author = $item->author) =~ s/\n//g if $item->author;

    my $msg = "[ $rss_name ] $title "
        . ($author eq "" ? "" : "<$author>")
        . " :: " . $item->link;

    my $time = str2time($item->pubDate);

    warn threads->tid() . "> send_rss_update: $title\n";

    remote_rss_update($msg);
}

sub remote_rss_update {
    $remote->post($config->{remote}->{name} . "/rss_update", shift) if $remote;
}

sub job_check_rss {
    my $queue = shift;

    while(my $rss_name = $queue->dequeue) {
        my $rss :shared = $config->{rss_list}->{$rss_name};
        my ($last_update, $items) = $parser{ $rss->{parser} }->($rss->{last_update}, $rss->{url});

        $rss->{last_update} = shared_clone($last_update);

        foreach my $item (@$items) {
            send_rss_update($rss_name, $item);
        }

        print "-" x 80, "\n";
    }

    print threads->tid(), "> quit\n";
}

sub parser_default {
    my ($last_update, $url) = @_;

    $last_update = 0 unless defined($last_update);
    my $new_last_update = $last_update;

    my $feedpp = XML::FeedPP->new($url);
    $feedpp->normalize();

    my $item_datetime;

    my @post_data;
    foreach($feedpp->get_item()) {
        $item_datetime = str2time($_->pubDate);
        if($item_datetime > $last_update) {
            push @post_data, $_ if $last_update;
            $new_last_update = $item_datetime if $new_last_update < $item_datetime;
        }
    }

    print "=" x 80, "\n";
    print threads->tid(), "old last update : $last_update\n";
    print threads->tid(), "new last update : $new_last_update\n";

    return ($new_last_update, \@post_data);
}

sub parser_perlmania {
    my ($last_update, $url) = @_;

    my %new_last_update = %$last_update if defined($last_update);
    my $feedpp = XML::FeedPP->new($url);

    my $item_datetime;

    my @post_data;
    foreach($feedpp->get_item()) {
        $_->link =~ /table=(.+)\&article=(\d+)$/;
        if(defined($last_update->{$1}) and $last_update{$1} < $2) {
            push @post_data, $_;
            $new_last_update{$1} = $2;
        }
    }

    return (\%new_last_update, \@post_data);
}

__END__
        - http://search.cpan.org/uploads.rdf
        - http://www.perlmania.or.kr/rss/perlmania.xml

